unit TestMappings;

interface

uses
  BaseTestCase, dorm.Mappings.Strategies, Rtti, TestFramework, superobject, dorm.Mappings;

type
  TCustomer = class
  private
    FName: String;
    FId: Integer;
  public
    property Id: Integer read FId write FId;
    property Name: String read FName write FName;
  end;

  TGetMappingDelegate = reference to procedure(AType: TRttiType; AMappingTable: TMappingTable);

  IFakeMappingStrategy = interface(IMappingStrategy)
    ['{6D760D36-6056-4CB1-AC2A-9F98852C80B9}']
    procedure SetGetMappingDelegate(const Delegate: TGetMappingDelegate);

    property GetMappingDelegate: TGetMappingDelegate write SetGetMappingDelegate;
  end;

  TFakeMappingStrategy = class(TInterfacedObject, IFakeMappingStrategy, IMappingStrategy)
  private
    FGetMappingDelegate: TGetMappingDelegate;
    procedure GetMapping(const AType: TRttiType; AMappingTable: TMappingTable);
    procedure SetGetMappingDelegate(const Delegate: TGetMappingDelegate);
  end;

  TMappingStrategyBaseTestCase = class(TTestCase)
  protected
    FContext: TRttiContext;
    FPersonType: TRttiType;
    FCarType: TRttiType;
    FFirstNameProperty: TRttiProperty;
    FCustomerType: TRttiType;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  end;

  TAttributesMappingStrategyTests = class(TMappingStrategyBaseTestCase)
  private
    FMapping: IMappingStrategy;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestTableName;
    procedure TestFieldName;
    procedure TestPKPropertyName;
  end;

  TCoCMappingStrategyTests = class(TMappingStrategyBaseTestCase)
  private
    FMapping: IMappingStrategy;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestGetMapping;
  end;

  TFileMappingStrategyTests = class(TMappingStrategyBaseTestCase)
  private
    FJson: ISuperObject;
    FMapping: IMappingStrategy;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestGetMapping;
    procedure TestGetMappingClassNotMapped;
  end;

  TMappingTableMergerTests = class(TTestCase)
  private
    FMerger: TMappingTableMerger;
    FOutput: TMappingTable;
    FMapping1: TMappingTable;
    FMapping2: TMappingTable;
    FMapping3: TMappingTable;
    procedure DoMerge;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestTablePropertiesFilledOnFirst;
    procedure TestTablePropertiesFilledOnSecond;
    procedure TestTablePropertiesFilledOnFirstAndSecond;
    procedure TestFields;
  end;

implementation

uses
  dorm.tests.bo, Classes;


function FindField(const Table: TMappingTable; const Field: String): TMappingField;
var
  i: Integer;
begin
  Result := Nil;
  for i := 0 to Table.Fields.Count - 1 do
    if Table.Fields[i].Name = Field then
      Exit(Table.Fields[i]);
end;

function FindHasOne(const Table: TMappingTable; const Name: String): TMappingRelation;
var
  i: Integer;
begin
  Result := Nil;
  for i := 0 to Table.HasOneList.Count - 1 do
    if Table.HasOneList[i].Name = Name then
      Exit(Table.HasOneList[i]);
end;

function FindHasMany(const Table: TMappingTable; const Name: String): TMappingRelation;
var
  i: Integer;
begin
  Result := Nil;
  for i := 0 to Table.HasManyList.Count - 1 do
    if Table.HasManyList[i].Name = Name then
      Exit(Table.HasManyList[i]);
end;


{ TFakeMappingStrategy }

procedure TFakeMappingStrategy.GetMapping(const AType: TRttiType; AMappingTable: TMappingTable);
begin
  FGetMappingDelegate(AType, AMappingTable);
end;

procedure TFakeMappingStrategy.SetGetMappingDelegate(
  const Delegate: TGetMappingDelegate);
begin
  FGetMappingDelegate := Delegate;
end;

{ TMappingStrategyBaseTestCase }

procedure TMappingStrategyBaseTestCase.SetUp;
begin
  inherited;
  FContext := TRttiContext.Create;
  FPersonType := FContext.GetType(TPerson);
  FFirstNameProperty := FPersonType.GetProperty('FirstName');

  FCarType := FContext.GetType(TCar);

  FCustomerType := FContext.GetType(TCustomer);
end;

procedure TMappingStrategyBaseTestCase.TearDown;
begin
  inherited;
  FContext.Free;
end;

{ TAttributesMappingStrategyTests }

procedure TAttributesMappingStrategyTests.SetUp;
begin
  inherited;
  FMapping := TAttributesMappingStrategy.Create;
end;

procedure TAttributesMappingStrategyTests.TearDown;
begin
  inherited;
  FMapping := Nil;
end;

procedure TAttributesMappingStrategyTests.TestFieldName;
begin
//  CheckEquals('COLUMN_FIRSTNAME', FMapping.FieldName(FFirstNameProperty));
end;

procedure TAttributesMappingStrategyTests.TestPKPropertyName;
begin
//  CheckEquals('ID', FMapping.PKPropertyName(FPersonType));
end;

procedure TAttributesMappingStrategyTests.TestTableName;
begin
//  CheckEquals('TABLE_PERSON', FMapping.TableName(FPersonType));

//  CheckEquals('', FMapping.TableName(FCarType), 'If the class don''t have the [Entity] attribute, table name should be empty');
end;

{ TCoCMappingStrategyTests }

procedure TCoCMappingStrategyTests.SetUp;
begin
  inherited;
  FMapping := TCoCMappingStrategy.Create;
end;

procedure TCoCMappingStrategyTests.TearDown;
begin
  inherited;
  FMapping := Nil;
end;

procedure TCoCMappingStrategyTests.TestGetMapping;
var
  Table: TMappingTable;
  Field: TMappingField;
  Rel: TMappingRelation;
begin
  Table := TMappingTable.Create;
  try
    FMapping.GetMapping(FPersonType, Table);

    CheckEquals('PERSON', Table.TableName);
    CheckEquals('dorm.tests.bo', Table.Package);
    CheckEquals(7, Table.Fields.Count);

    Field := FindField(Table, 'ID');
    CheckEquals('ID', Field.FieldName);
    CheckEquals('integer', Field.FieldType);

    Field := FindField(Table, 'FirstName');
    CheckEquals('FIRSTNAME', Field.FieldName);
    CheckEquals('string', Field.FieldType);
    CheckEquals(0, Field.Size);

    Field := FindField(Table, 'LastName');
    CheckEquals('LASTNAME', Field.FieldName);
    CheckEquals('string', Field.FieldType);
    CheckEquals(0, Field.Size);

    Field := FindField(Table, 'Age');
    CheckEquals('AGE', Field.FieldName);
    CheckEquals('integer', Field.FieldType);

    Field := FindField(Table, 'BornDate');
    CheckEquals('BORNDATE', Field.FieldName);
    CheckEquals('date', Field.FieldType);

    Field := FindField(Table, 'BornTimeStamp');
    CheckEquals('BORNTIMESTAMP', Field.FieldName);
    CheckEquals('datetime', Field.FieldType);

    Field := FindField(Table, 'Photo');
    CheckEquals('PHOTO', Field.FieldName);
    CheckEquals('blob', Field.FieldType);

    CheckNull(FindField(Table, 'FullName'));

    CheckEquals(2, Table.HasOneList.Count);
    Rel := FindHasOne(Table, 'Car');
    CheckEquals('TCar', Rel.ChildClassName);
    CheckEquals('PersonID', Rel.ChildFieldName);
    CheckFalse(Rel.LazyLoad);

    Rel := FindHasOne(Table, 'Email');
    CheckEquals('TEmail', Rel.ChildClassName);
    CheckEquals('PersonID', Rel.ChildFieldName);
    CheckFalse(Rel.LazyLoad);

    CheckEquals(1, Table.HasManyList.Count);
    Rel := FindHasMany(Table, 'Phones');
    CheckEquals('TPhone', Rel.ChildClassName);
    CheckEquals('PersonID', Rel.ChildFieldName);
    CheckFalse(Rel.LazyLoad);
  finally
    Table.Free;
  end;
end;

{ TFileMappingStrategyTests }

procedure TFileMappingStrategyTests.SetUp;
var
  Reader: TStreamReader;
  Content: String;
begin
  inherited;
  Reader := TStreamReader.Create('dorm_firebird.conf');
  try
    Content := Reader.ReadToEnd;
    FJson := TSuperObject.ParseString(PChar(Content), True);
  finally
    Reader.Free;
  end;

  FMapping := TFileMappingStrategy.Create(FJson, 'test');
end;

procedure TFileMappingStrategyTests.TearDown;
begin
  inherited;
  FJson := Nil;
  FMapping := Nil;
end;

procedure TFileMappingStrategyTests.TestGetMapping;
var
  Table: TMappingTable;
  Field: TMappingField;
  Rel: TMappingRelation;
begin
  Table := TMappingTable.Create;
  try
    FMapping.GetMapping(FPersonType, Table);
    CheckEquals('PEOPLE', Table.TableName);
    CheckEquals('dorm.tests.bo', Table.Package);
    CheckEquals(7, Table.Fields.Count);

    Field := FindField(Table, 'ID');
    CheckEquals('ID', Field.FieldName);
    CheckEquals('integer', Field.FieldType);
    CheckEquals(0, Field.Size);

    Field := FindField(Table, 'FirstName');
    CheckEquals('FIRST_NAME', Field.FieldName);
    CheckEquals('string', Field.FieldType);
    CheckEquals(50, Field.Size);

    Field := FindField(Table, 'LastName');
    CheckEquals('LAST_NAME', Field.FieldName);
    CheckEquals('string', Field.FieldType);
    CheckEquals(50, Field.Size);

    Field := FindField(Table, 'Age');
    CheckEquals('AGE', Field.FieldName);
    CheckEquals('integer', Field.FieldType);
    CheckEquals(0, Field.Size);

    Field := FindField(Table, 'BornDate');
    CheckEquals('BORN_DATE', Field.FieldName);
    CheckEquals('date', Field.FieldType);
    CheckEquals(0, Field.Size);

    Field := FindField(Table, 'BornTimeStamp');
    CheckEquals('BORN_DATE_TIME', Field.FieldName);
    CheckEquals('datetime', Field.FieldType);
    CheckEquals(0, Field.Size);

    Field := FindField(Table, 'Photo');
    CheckEquals('PHOTO', Field.FieldName);
    CheckEquals('blob', Field.FieldType);
    CheckEquals(0, Field.Size);

    CheckEquals(2, Table.HasOneList.Count);
    Rel := FindHasOne(Table, 'Car');
    CheckEquals('TCar', Rel.ChildClassname);
    CheckEquals('PersonID', Rel.ChildFieldName);
    CheckFalse(Rel.LazyLoad);

    Rel := FindHasOne(Table, 'Email');
    CheckEquals('TEmail', Rel.ChildClassName);
    CheckEquals('PersonID', Rel.ChildFieldName);
    CheckFalse(Rel.LazyLoad);

    CheckEquals(1, Table.HasManyList.Count);
    Rel := FindHasMany(Table, 'Phones');
    CheckEquals('TPhone', Rel.ChildClassName);
    CheckEquals('PersonID', Rel.ChildFieldName);
    CheckFalse(Rel.LazyLoad);
  finally
    Table.Free;
  end;
end;

procedure TFileMappingStrategyTests.TestGetMappingClassNotMapped;
var
  Table: TMappingTable;
begin
  Table := TMappingTable.Create;
  try
    FMapping.GetMapping(FCustomerType, Table);
    CheckEquals('', Table.TableName);
  finally
    Table.Free;
  end;
end;

{ TMappingTableMergerTests }

procedure TMappingTableMergerTests.DoMerge;
begin
  FMerger.Merge(FOutput, [FMapping1, FMapping2, FMapping3]);
end;

procedure TMappingTableMergerTests.SetUp;
begin
  inherited;
  FMerger := TMappingTableMerger.Create;
  FOutput := TMappingTable.Create;
  FMapping1 := TMappingTable.Create;
  FMapping2 := TMappingTable.Create;
  FMapping3 := TMappingTable.Create;
end;

procedure TMappingTableMergerTests.TearDown;
begin
  inherited;
  FMapping3.Free;
  FMapping2.Free;
  FMapping1.Free;
  FOutput.Free;
  FMerger.Free;
end;

procedure TMappingTableMergerTests.TestFields;
var
  Field: TMappingField;
begin
  with FMapping1.AddField do
  begin
    Name := 'PropertyA';
    FieldName := 'FieldA';
    FieldType := 'String';
  end;

  with FMapping1.AddField do
  begin
    Name := 'PropertyB';
    FieldName := 'FieldB';
    FieldType := 'String';
  end;

  with FMapping2.AddField do
  begin
    Name := 'PropertyA';
    FieldName := '__FieldB';
    FieldType := 'Integer';
  end;

  with FMapping2.AddField do
  begin
    Name := 'PropertyC';
    FieldName := 'FieldC';
    FieldType := 'String';
  end;

  with FMapping2.AddField do
  begin
    Name := 'PropertyD';
    FieldName := 'FieldD';
    FieldType := 'String';
  end;

  DoMerge;

  CheckEquals(4, FOutput.Fields.Count);
  Field := FindField(FOutput, 'PropertyA');
  CheckEquals('FieldA', Field.FieldName);
  CheckEquals('String', Field.FieldType);

  Field := FindField(FOutput, 'PropertyB');
  CheckEquals('FieldB', Field.FieldName);
  CheckEquals('String', Field.FieldType);

  Field := FindField(FOutput, 'PropertyC');
  CheckEquals('FieldC', Field.FieldName);
  CheckEquals('String', Field.FieldType);

  Field := FindField(FOutput, 'PropertyD');
  CheckEquals('FieldD', Field.FieldName);
  CheckEquals('String', Field.FieldType);
end;

procedure TMappingTableMergerTests.TestTablePropertiesFilledOnFirst;
begin
  FMapping1.TableName := 'Foo';
  DoMerge;
  CheckEquals('Foo', FOutput.TableName);
end;

procedure TMappingTableMergerTests.TestTablePropertiesFilledOnFirstAndSecond;
begin
  FMapping1.TableName := 'Foo';
  FMapping2.TableName := 'Bar';
  DoMerge;
  CheckEquals('Foo', FOutput.TableName);
end;

procedure TMappingTableMergerTests.TestTablePropertiesFilledOnSecond;
begin
  FMapping2.TableName := 'Foo';
  DoMerge;
  CheckEquals('Foo', FOutput.TableName);
end;

initialization
RegisterTest(TAttributesMappingStrategyTests.Suite);
RegisterTest(TCoCMappingStrategyTests.Suite);
RegisterTest(TFileMappingStrategyTests.Suite);
RegisterTest(TMappingTableMergerTests.Suite);

end.
